#!/usr/bin/perl -w
use strict;
$| = 1;

#
#       Copyright (C) 2008-2012 Александр Девяткин, "Зелёная горка"
#
#       Разрешается повторное распространение и использование как в виде исходного
#       кода, так и в двоичной форме, с изменениями или без, при соблюдении следующих
#       условий:
#
#       * При повторном распространении исходного кода должно оставаться указанное
#         выше уведомление об авторском праве, этот список условий и последующий
#         отказ от гарантий.
#       * При повторном распространении двоичного кода должна сохраняться указанная
#         выше информация об авторском праве, этот список условий и последующий отказ
#         от гарантий в документации и/или в других материалах, поставляемых при
#         распространении.
#       * Ни название "Зелёная горка", ни имена ее сотрудников не могут быть
#         использованы в качестве поддержки или продвижения продуктов, основанных
#         на этом ПО без предварительного письменного разрешения.
#
#       ЭТА ПРОГРАММА ПРЕДОСТАВЛЕНА ВЛАДЕЛЬЦАМИ АВТОРСКИХ ПРАВ И/ИЛИ ДРУГИМИ СТОРОНАМИ
#	"КАК ОНА ЕСТЬ" БЕЗ КАКОГО-ЛИБО ВИДА ГАРАНТИЙ, ВЫРАЖЕННЫХ ЯВНО ИЛИ ПОДРАЗУМЕВАЕМЫХ,
#	ВКЛЮЧАЯ, НО НЕ ОГРАНИЧИВАЯСЬ ИМИ, ПОДРАЗУМЕВАЕМЫЕ ГАРАНТИИ КОММЕРЧЕСКОЙ ЦЕННОСТИ
#	И ПРИГОДНОСТИ ДЛЯ КОНКРЕТНОЙ ЦЕЛИ. НИ В КОЕМ СЛУЧАЕ, ЕСЛИ НЕ ТРЕБУЕТСЯ
#	СООТВЕТСТВУЮЩИМ ЗАКОНОМ, ИЛИ НЕ УСТАНОВЛЕНО В УСТНОЙ ФОРМЕ, НИ ОДИН ВЛАДЕЛЕЦ
#	АВТОРСКИХ ПРАВ И НИ ОДНО ДРУГОЕ ЛИЦО, КОТОРОЕ МОЖЕТ ИЗМЕНЯТЬ И/ИЛИ ПОВТОРНО
#	РАСПРОСТРАНЯТЬ ПРОГРАММУ, КАК БЫЛО СКАЗАНО ВЫШЕ, НЕ НЕСЁТ ОТВЕТСТВЕННОСТИ,
#	ВКЛЮЧАЯ ЛЮБЫЕ ОБЩИЕ, СЛУЧАЙНЫЕ, СПЕЦИАЛЬНЫЕ ИЛИ ПОСЛЕДОВАВШИЕ УБЫТКИ,
#	ВСЛЕДСТВИЕ ИСПОЛЬЗОВАНИЯ ИЛИ НЕВОЗМОЖНОСТИ ИСПОЛЬЗОВАНИЯ ПРОГРАММЫ (ВКЛЮЧАЯ,
#	НО НЕ ОГРАНИЧИВАЯСЬ ПОТЕРЕЙ ДАННЫХ, ИЛИ ДАННЫМИ, СТАВШИМИ НЕПРАВИЛЬНЫМИ, ИЛИ
#	ПОТЕРЯМИ ПРИНЕСЕННЫМИ ИЗ-ЗА ВАС ИЛИ ТРЕТЬИХ ЛИЦ, ИЛИ ОТКАЗОМ ПРОГРАММЫ РАБОТАТЬ
#	СОВМЕСТНО С ДРУГИМИ ПРОГРАММАМИ), ДАЖЕ ЕСЛИ ТАКОЙ ВЛАДЕЛЕЦ ИЛИ ДРУГОЕ ЛИЦО БЫЛИ
#	ИЗВЕЩЕНЫ О ВОЗМОЖНОСТИ ТАКИХ УБЫТКОВ.
#

#       Copyright (C) 2008-2012 Aleksandr Deviatkin, "Green Hill"
#
#       Redistribution and use in source and binary forms, with or without
#       modification, are permitted provided that the following conditions are
#       met:
#       
#       * Redistributions of source code must retain the above copyright
#         notice, this list of conditions and the following disclaimer.
#       * Redistributions in binary form must reproduce the above
#         copyright notice, this list of conditions and the following disclaimer
#         in the documentation and/or other materials provided with the
#         distribution.
#       * Neither the name of the Green Hill nor the names of its
#         contributors may be used to endorse or promote products derived from
#         this software without specific prior written permission.
#       
#       THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
#       "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
#       LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
#       A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
#       OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
#       SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
#       LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
#       DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
#       THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
#       (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
#       OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#

#
# port_locator
# Вычисление распределения групп по портам iface
# 2014-05-12 alid
#


use lib "$ENV{MY}/counter";
use Mercury;
use Lock;
use DBI;

my (@args, %opts);
foreach(@ARGV){
   if(/^\-(\S)(.*)/){	$opts{$1} = $2;	} else {	push @args, $_;	}
}
my $verb = exists $opts{v};
my $commit = exists $opts{f};	# Коммитить изменения в базу. Без этого ключа - демо режим.
my $retries = (exists $opts{r}) ? $opts{r} : 10;
my ($database) = (@args);
die "Usage: $0 database"	unless($database);

my $plock = '/tmp/port_locator.lock';
my $lock = Lock->new($plock,1);
die "port_locator: Locked"	if($lock->set);

my $dbh = DBI->connect("dbi:Pg:dbname=$database","","",{AutoCommit => 0})	or die;
# Список интерфейсов
my $Iface;
my $sth = $dbh->prepare("SELECT id,dev FROM iface");
$sth->execute();
while(my $r = $sth->fetchrow_hashref) {
	$Iface->{$r->{id}} = $r;
}
$sth->finish;

# Список групп
my $Mgroup;
$sth = $dbh->prepare("SELECT id,active,name,if_id,memo,rank,bid,modtime FROM mgroup WHERE active=1");
my $upd = $dbh->prepare("UPDATE mgroup SET if_id=?,modtime=now() WHERE id=?");
$sth->execute();
while(my $r = $sth->fetchrow_hashref) { $Mgroup->{$r->{id}} = $r; }
$sth->finish;
	
# Список счетчиков
my $CList;
$sth = $dbh->prepare("SELECT A.id AS id,addr,mgroup,passwd,passwd2,model,B.type AS ctype FROM counters A INNER JOIN counter_type B ON A.model=B.id WHERE A.active=1 ORDER BY random()");
$sth->execute();
while(my $r = $sth->fetchrow_hashref) { $CList->{$r->{mgroup}}->{$r->{id}} = $r; }
$sth->finish;
# Оставляем в списке только уникальные адреса
my $List;
foreach my $gid (keys %{$CList}) {
	foreach my $cid (keys %{$CList->{$gid}}) {
		my $addr = $CList->{$gid}->{$cid}->{addr};
		my $distinct = 1;
		foreach my $g (keys %{$CList}) {
			next	if($gid == $g);
			foreach my $c (keys %{$CList->{$g}}) {
				next	if($c =~ m/\D/);
				if($addr eq $CList->{$g}->{$c}->{addr}) {
					undef $distinct;
					last;
				}
			}
			last	unless($distinct);
		}
		if($distinct) {
			$List->{$gid} = $CList->{$gid}->{$cid};
			$CList->{$gid}->{D} = 1;	#
			last;						# В каждой группе - по одному уникальному адресу
		}
	}
}

# Подбираем каждой группе интерфейс
foreach my $gid (keys %{$List}) {
	foreach my $if_id (keys %{$Iface}) {
		next	unless($Iface->{$if_id}->{dev});
		if(iftest($Iface->{$if_id}->{dev},$List->{$gid})) {	# пробуем этот интерфейс
			# upd Прописываем интерфейс в таблице групп
			$upd->execute($if_id,$gid);
			print "gid: $gid iface: $if_id\n"	if($verb);
			# Удаляем этот интерфейс из списка, чтобы больше его не трогать
			delete $Iface->{$if_id};
			# Удаляем группу из списка
			delete $List->{$gid};
			last;
		}
	}
}
# Группы, которым не удалось подобрать интерфейс
foreach my $gid (keys %{$List}) {
	print STDERR "Unconnected group: [$gid] ".$Mgroup->{$gid}->{name}."\n";
	$upd->execute(0,$gid);	# Несуществующий интерфейс
}

# Если остались группы, из которых не удалось выделить уникальные адреса, то с ними разбираемся отдельно
# Пытаемся подобрать им интерфейс из оставшихся незанятых
foreach my $gid (keys %{$CList}) {
	next	if($CList->{$gid}->{D});
	my $C;
	foreach(keys %{$CList->{$gid}}) {
		$C = $CList->{$gid}->{$_};	#	Первый попавшийся счетчик из группы
		last;
	}
	# подбираем ему интерфейс
	foreach my $if_id (keys %{$Iface}) {
		next	unless($Iface->{$if_id}->{dev});
		if(iftest($Iface->{$if_id}->{dev},$C)) {	# пробуем этот интерфейс
			# Прописываем интерфейс в таблице групп
			$upd->execute($if_id,$gid);
			print "gid: $gid iface: $if_id (non-unique group)\n"	if($verb);
			# Удаляем этот интерфейс из списка, чтобы больше его не трогать
			delete $Iface->{$if_id};
			$CList->{$gid}->{D} = 1;	#
			last;
		}
	}
}
# Совсем безнадежные группы, если таковые остались
foreach my $gid (keys %{$CList}) {
	next	if($CList->{$gid}->{D});
	print STDERR "Unconnected group: [$gid] ".$List->{$gid}->{name}."\n";
	$upd->execute(0,$gid);	# Несуществующий интерфейс
}

$dbh->commit	if($commit);
$dbh->disconnect;
$lock->clear;

# subs
sub iftest {
	my ($device, $G) = @_;
	my $retries = 10;

	my $addr;
	if($G->{ctype} eq 'M203') {
		$addr = sprintf("%08x",$G->{addr});
		$addr =~ s/(\w\w)(\w\w)(\w\w)(\w\w)/$1 $2 $3 $4/;
	}
	elsif($G->{ctype} eq 'M230') {
		$addr = sprintf("%x",$G->{addr});
	}
	print "Addr: [$addr] $G->{ctype}\n"	if $verb;

	my $STALL_DEFAULT=2;	# how many seconds to wait for new input
	my $MAXLENGTH = 255;	# наибольшая длина пакета

	my $status = '';

	print "Connection testing $device addr: ".$G->{addr}."... "	if $verb;
	eval {
		my $connect = Mercury->new($device,$G->{ctype},$addr,$G->{passwd},1,$retries,$verb);
		$status = $connect->tst();
		$connect->quit();
		};

	print "$status"	if $verb;
	if($status=~/ok/) {
		print " OK\n"	if($verb);
		return 1;
	} else {
		print " failed\n"	if($verb);
		return 0;
	}
}

